program mge2xx

	use mpsge
	use mpsGP
	use mpsGMS

        implicit none

        character (len=255) :: fname, fnameroot
	integer ios, n1, astat   ! KP
	logical :: InputFileExists, openok, InputHarFileExists, DoMGEConversion
	character :: ch1
	logical :: FoundANest, HaveConvertedMGEFile, ConvertMGEIfNecessary

	character (len=1024) :: CMDLine ! KP

! For calling GEMPACK routines to find out info on a Header Array file
!       GPRCON,GPRCNI stored as common blocks to control various run-time
!	   features such as recovery from invalid input, full/brief prompts,
!          whether running from Stored-input/Command file etc.
!
	integer gprcni(50)
	common /gpruni/ gprcni
	character*128 gprcon
	common /gprun/ gprcon


! For program name and version - keep a brief history here
	character(len=50), parameter :: ProgVersion = &
! Version 1. May 2004. Implementation to accompany paper delivered at
!   GTAP conference in Washington DC, June 2004.
	   ' Version 1. May 2004>'
	character (len=10) :: ProgName

		
! [26/04/04] Have one version (called MGE2GP) which always converts
!  to GEMPACK. Set ThisIsMGE2GP true for this version
	ThisIsMGE2GP = .true.  ! change for other versions

! Set ProgName
	if(ThisIsMGE2GP) then
	  ProgName = 'MGE2GP'
	else
	  ProgName = 'MGE2XX'
	end if

	HaveConvertedMGEFile = .false.
	ConvertMGEIfNecessary = .true.

	nullify(gmsrecords)

! Initialize all error message strings  ! KP
	call InitializeMessages('all',0) ! KP

! Output program name and version
	write(*,'(/,2x,2a,1x,a,/)') '<', trim(ProgName), ProgVersion

	

!!      Read file name and model name from the command line:

        call getcl(CMDLine)
	call ProcessCommandLine(CMDLine)

! Temporary
!	fnameroot='basic'
!	fnameroot='demo'
!	fnameroot='demo2'
! Now expect InputFileName on command line - later may prompt for it if not there.
	if(InputFileName.ne.' ') then
	  n1 = INDEX(InputFileName,'.',back=.true.)
	  if(n1.gt.1) then
! If they give a suffix, open this file on IOMPS and use fnameroot as the
!  root for other names.
! ?? Or should we insist on '.mge' for the input file?
	    fnameroot = InputFileName(1:n1-1)
	  else
	    fnameroot = InputFileName
! [17/04/04] If no suffix supplied, must add './mge'
! This testing of InputFileExists before adding '.mge' meant that may set
!  InputFileName equal to the name of a subdirectory.
!NO	    inquire(file=InputFileName, Exist=InputFileExists)
!NO	    if (.not.InputFileExists) InputFileName = trim(InputFileName)//'.mge'
	    InputFileName = trim(InputFileName)//'.mge'
	  end if
	else
	  call InitializeMessages('all',0)
	  call ErrorStop('Expect input file name to be on the command line.')
	end if
	  

! KP Set values to tell what conversions want to do
! Now set from the command line

	InputFileExists = .false.
	inquire(file=InputFileName, Exist=InputFileExists)

	if(.not.InputFileExists) then
	  call InitializeMessages('all',0)
	  call ErrorStop('Unable to open Input file "'//trim(InputFileName)//'". It does not exist')
	end if

	openok=.false.
        open(iomps,file=trim(InputFileName),status='old',err=18)
	openok=.true.
18	continue
	if(.not.openok) then
	  call InitializeMessages('all',0)
	  call ErrorStop('Unable to open Input MPSGE file')
	end if

	if(ConvertToGAMS) then   ! KP
!          open(iogms,file='basic_mps.gms')
! Delete IOGMS file if it exists
	  fname=trim(fnameroot)//'_mge.gms'
	  openok=.false.
          open(iogms,file=fname,status='old', err=22)  ! KP
	  openok=.true.
22	  continue
	  if(openok) then
	    close(unit=iogms, status='delete')
	  end if
! Open new file on IOGMS
	  openok=.false.
	  open(iogms,file=fname,status='new',err=23)
	  openok=.true.
23	  continue
	  if(.not.openok) then
	    call InitializeMessages('all',0)
	    call ErrorStop('Unable to open new GMS file')
	  end if
	end if

	if(ConvertToGEMPACK) then
	  NewMGEFileName = trim(fnameroot)//'_mge2gp.mge'
	else
	  NewMGEFileName = trim(fnameroot)//'_mge2xx.mge'
	end if

! [17/04/04] Can omit this - the equivalent is done in the DoMGEConversion part.
!NO	if(ConvertToMGE) open(iomge,file=trim(fnameroot)//'_kp.mge')

! Return to here to reprocess converted MGE file when are converting to
!  GEMPACK and have found nests in the original MGE file.
180	continue

!      Master routine to read an MPSGE input file:
!        - Read one line at a time into a linked list for listing.
!        - Locate functions and set up pointers to the constituent records.
!        - Parse records into fields.
!
	if(log) write(*,*)'Calling readmps'
        call readmps

!      Parse all fields in the file into constituent elements:
!      - Field identifier text
!      - Identifier argument text
!      - Spanning domain text
!      - Condition text.

	if(log) write(*,*)'Calling parse'
        call parse

!       Read variables:

	if(log) write(*,*)'Calling readvar'
        call readvar

!       Add sector ids to the symbol table and verify that
!       multiple prod blocks have not be included.

        call sectors

!       Check input syntax on prod: records:

        call chkprod

!       Check input syntax on demand: records:

        call chkdemand

!       Read the nesting assignments from the $prod line:

        call readnest

!       Read production function coefficients and set up list of
!       nest elements:

        call readcoef

!--------------------------------------------------
	if(ConvertToGEMPACK) then

! Check to see if these are nests. If so, convert MGE file to one with no nests
	  call AreThereNests(FoundANest)

	  if(HaveConvertedMGEFile.and.FoundANest) then
	    call InternalErrorStop('There should be no nests now.')
	  end if

	end if ! if(ConvertToGEMPACK) then

! Convert the MGE file to a second MGE file.
! 1. If converting to GEMPACK, do this if find a nest in the original MGE file.
! 2. Also do this if ConvertToMGE is true.
	DoMGEConversion = .false.
	if(ConvertToGEMPACK) then
	  DoMGEConversion = ConvertMGEIfNecessary .and. FoundANest
	else if(ConvertToMGE) then
	  DoMGEConversion = .true.
	end if
 
	if(DoMGEConversion) then

	  if(ConvertToGEMPACK) then

! Translate to a file without nests, and use that file to convert to GEMPACK

	    write(*,*)'Found a nest - converting to file with no nests'

	  end if

! Open this file on unit IOMGE as a new file
	    openok=.false.
	    open(iomge,file=NewMGEFileName,status='old', err=128)
	    openok=.true.
128	    continue
	    if(openok) then
	      close(unit=iomge, status='delete')
	    end if
! Open new file on IOMGE
	    openok=.false.
	    open(iomge,file=newMGEFileName,status='new',err=132)
	    openok=.true.
132	    continue
	    if(.not.openok) then
	      call InitializeMessages('all',0)
	      call ErrorStop('Unable to open new MGE file')
	    end if

! {17/04/04] Code here replaced by call to routine RewriteMGEFile ! KP 
	    call RewriteMGEFile
!         Generate indices for all the nests and netputs:

!REWRITE	    call indices
! [17/04/04] Added thanks to Tom R email
!REWRITE	    call functions
!REWRITE	    call rewritemodel

	end if ! if(DoMGEConversion) then

	if(ConvertToGEMPACK.and.DoMGEConversion) then

	    write(*,*)'Finished converting to file with no nests'

! Close input file and attach to file where have rewritten the model
	    close(unit=iomps, status='keep')
	    close(unit=iomge, status='keep')
! Reopen file on unit IOMPS
	    openok=.false.
	    open(iomps,file=newMGEFileName,status='old',err=134)
	    openok=.true.
134	    continue
	    if(.not.openok) then
	      call InitializeMessages('all',0)
	      call ErrorStop('Unable to reopen new MGE file')
	    end if

! Now are ready to convert the new MGE file to TAB and CMF files
	    HaveConvertedMGEFile = .true.

	end if ! if(ConvertToGEMPACK.and.DoMGEConversion) then

	if(ConvertToGEMPACK) then

! Set ConvertMGEIfNecessary false now have done any conversion which is needed
! Hence this will be false if jump back to 180
	  ConvertMGEIfNecessary = .false.

	  if(HaveConvertedMGEFile.and.FoundANest) then
! FoundANest will be false the second time through
! Process the modified file
	    goto 180
	  end if

!--------------------------------------------------
! Open files

! Delete IOTABGP file if it exists
 	  tabfileroot=trim(fnameroot)  
	  fname=trim(tabfileroot)//'.tab'
	  openok=.false.
	  open(iotabgp,file=fname,status='old', err=24)
	  openok=.true.
24	  continue
	  if(openok) then
	    close(unit=iotabgp, status='delete')
	  end if
! Open new file on IOTABGP
	  openok=.false.
	  open(iotabgp,file=fname,status='new',err=26)
	  openok=.true.
26	  continue
	  if(.not.openok) then
	    call InitializeMessages('all',0)
	    call ErrorStop('Unable to open new TAB file')
	  end if
	  tabfilename=fname

! Delete IOCMFGP file if it exists  
! The Command file written does a homogeneity simulation
! [17/04/04] Use "HSIM" standing for Homogeneity SIMulation
!WAS	  fname=trim(tabfileroot)//'homo.cmf'
	  fname=trim(tabfileroot)//'hsim.cmf'
	  openok=.false.
	  open(iocmfgp,file=fname,status='old', err=28)
	  openok=.true.
28	  continue
	  if(openok) then
	    close(unit=iocmfgp, status='delete')
	  end if
! Open new file on IOCMFGP
	  openok=.false.
	  open(iocmfgp,file=fname,status='new',err=32)
	  openok=.true.
32	  continue
	  if(.not.openok) then
	    call InitializeMessages('all',0)
	    call ErrorStop('Unable to open new Command file')
	  end if
	  cmffilename=fname

! [03/06/04] TABLO STI file for running TABLO
! Delete IOTABSTIGP file if it exists
	  fname='t'//trim(tabfileroot)//'.sti'
	  openok=.false.
	  open(iotabstigp,file=fname,status='old', err=44)
	  openok=.true.
44	  continue
	  if(openok) then
	    close(unit=iotabstigp, status='delete')
	  end if
! Open new file on IOTABGP
	  openok=.false.
	  open(iotabstigp,file=fname,status='new',err=46)
	  openok=.true.
46	  continue
	  if(.not.openok) then
	    call InitializeMessages('all',0)
	    call ErrorStop('Unable to open new TABLO STI file')
	  end if
	  tabstifilename=fname

! Use HAR file info? At present, do so if corresponding .HAR file exists
	  UseHarFileInfo = .false.
! [26/04/04] Suppress this with comment !HAR for the present
!HAR	  harfilename = trim(tabfileroot)//'.har'
!	  write(*,*)'HARFILENAME=', trim(harfilename) 
!HAR	  InputHarFileExists = .false.
!HAR	  inquire(file=harfilename, Exist=InputHarFileExists)
! Temporarily suppress this
!HAR	  InputHarFileExists = .false.
!HAR	  if(InputHarFileExists) then
!HAR	    openok=.false.
!HAR	    open(iohargp,file=harfilename,status='old',form='unformatted',err=34)
!HAR	    write(*,*)'HAR file opened ok'
!HAR	    openok=.true.
34	    continue
!HAR	    if(.not.openok) then
!HAR	      call InitializeMessages('all',0)
!HAR	      call ErrorStop('Unable to open old HAR file '//trim(harfilename))
!HAR	    end if
!HAR	    UseHarFileInfo = .true.
!HAR	    ch1='?'
!HAR	    read(iohargp) ch1
!HAR	    write(*,*)'CH1=', ch1
!HAR	  end if ! if(InputHarFileExists) then

!--------------------------------------------------

!  Temporary
!	  call sectors

	  if(UseHarFileInfo) then
! [26/04/04] Suppress all of this for now so that linking does not require
!   GEMPACK 7.0 libraries.
! Suppress with comment !HAR 
! Here are using routines from Release 7.0 of GEMPACK.
! Initialise things as GEMPACK programs expect
!.call	    call GPSTRT(prognv,dates,.TRUE.,.FALSE.,prname,errmes)
!HAR	    call GPSTRT('<'//trim(ProgName)//trim(ProgVersion),'2004',.FALSE.,.FALSE.,trim(ProgrName),errmes)
!HAR	    if( errmes(1:1).eq.'E') call InternalErrorStop('Error in routine GPSTRT')
! Find out how many headers (NumHeadOnHarFile) are on this file
!HAR	    call HAHMA( iohargp, NumHeadOnHarFile, errmes)
!HAR	    if( errmes(1:1).eq.'E') call InternalErrorStop('Error in routine HAHMA')
!HAR	    call GPTO1('There are %i headers on the file', ' ', NumHeadOnHarFile, errmes)
!HAR	    if( errmes(1:1).eq.'E') call InternalErrorStop('Error in routine GPTO1')
! Allocate the relevant arrays
!HAR	    allocate( HeadOnFile(NumHeadOnHarFile), HeadTypeOnFile(NumHeadOnHarFile), &
!HAR	      LongNameOnFile(NumHeadOnHarFile), &
!HAR              SizeOnFile(NumHeadOnHarFile,7), CHLENOnFile(NumHeadOnHarFile), &
!HAR	      StatusOnFile(NumHeadOnHarFile), &
!HAR              CoeffAndArgsOnFile(NumHeadOnHarFile), TPSTELOnFile(NumHeadOnHarFile), stat=astat)
!HAR	    if(astat.ne.0) call InternalErrorStop('Error allocating arrays for HA file info')
! Get info about the headers on the file
!HAR            call LSTHDS( iohargp, NumHeadOnHarFile, 'NumHeadOnHarFile', HeadOnFile, 1, n1, &
!HAR              HeadTypeOnFile, SizeOnFile, 7, LongNameOnFile, .TRUE., .TRUE., .TRUE., &
!HAR              CoeffAndArgsOnFile, TPSTELOnFile, ',', errmes)
!HAR	    if( errmes(1:1).eq.'E') call InternalErrorStop( &
!HAR		'Error in routine LSTHDS. Is the file a FUJITSU file?'// &
!HAR		'\n ** Lahey files will not work **')
	  end if ! if(UseHarFileInfo) then

	write(*,'(/,1x,a)') 'Beginning translation to GEMPACK'

! Set up GEMPACK names
	  call SetupGEMPACKNames

!	KP. Convert to GEMPACK
!	Writes TAB file and CMF file

	  call ConvertToGP

	end if ! if(ConvertToGEMPACK) then
!--------------------------------------------------

	if(ConvertToGAMS) then    ! added by KP

!         Output some tests of the input data:

          call testsym

!         Generate indices for all the nests and netputs:

          call indices

          call functions

          call buildmodel

	  call writemodel

!	 End "if(ConvertToGAMS) then"
	end if

! [17/04/04] Can now omit this - is done in the DoMGEConversion part above.
!NO	if(ConvertToMGE) then    ! added by TFR

!         Generate indices for all the nests and netputs:

! {17/04/04] Code here replaced by call to routine RewriteMGEFile ! KP 
!NO	call RewriteMGEFile

!REWRITE	    call indices
! [17/04/04] Added thanks to Tom R email
!REWRITE	    call functions
!REWRITE	    call rewritemodel

!	 End "if(ConvertToMGE) then"
!NO	end if

        end program mge2xx
